home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 2.2 / CompressedOrderedCollection.st < prev    next >
Text File  |  1993-07-24  |  14KB  |  471 lines
  1. "    NAME        CompressedOrderedCollection
  2.     AUTHOR        RMD@cs.man.ac.uk
  3.     FUNCTION like RunArrays, for OrderedCollections 
  4.     ST-VERSIONS    2.2
  5.     PREREQUISITES     
  6.     CONFLICTS    
  7.     DISTRIBUTION      world
  8.     VERSION        1.1
  9.     DATE    22 Jan 1989
  10. SUMMARY    CompressedOrderedCollection
  11.     Similar to RunArrays, but for
  12.     OrderedCollections. (2.2). RMD.
  13. "!
  14. 'From Smalltalk-80, Version 2.3 of 13 June 1988 on 18 May 1989 at 10:59:56 am'!
  15.  
  16. Object subclass: #Run
  17.     instanceVariableNames: 'length value '
  18.     classVariableNames: ''
  19.     poolDictionaries: ''
  20.     category: 'Collections-Sequenceable'!
  21. Run comment:
  22. 'I represent a sequence of a particular value. I am used by CompressedOrderedCollection.
  23.  
  24. Instance Variables
  25.  
  26. length <Integer>    The number of instances of my value which I represent.
  27. value    <Anything>    The value which I represent'!
  28.  
  29.  
  30. !Run methodsFor: 'removing'!
  31.  
  32. decreaseLength: anInteger
  33.     "Remove anInteger items, returning my value"
  34.  
  35.     length - anInteger < 0
  36.     ifTrue:[self error: 'under run'].
  37.     length _ length - anInteger.
  38.     ^value!
  39.  
  40. decrementLength
  41.     "Remove one item, returning my value"
  42.  
  43.     length <= 0
  44.     ifTrue:[self error: 'under run'].
  45.     length _ length - 1.
  46.     ^value! !
  47.  
  48. !Run methodsFor: 'adding'!
  49.  
  50. increaseLength: anInteger
  51.     "Add anInteger to the length."
  52.  
  53.     length _ length + anInteger!
  54.  
  55. incrementLength
  56.     "Add one to the length."
  57.  
  58.     length _ length + 1! !
  59.  
  60. !Run methodsFor: 'accessing'!
  61.  
  62. length
  63.     "Return the length of this run"
  64.  
  65.     ^length!
  66.  
  67. length: anInteger
  68.     "Set the length of this run"
  69.  
  70.     length _ anInteger!
  71.  
  72. length: anInteger value: anObject
  73.     "set the length and value of this run"
  74.  
  75.     length _ anInteger.
  76.     value _ anObject!
  77.  
  78. value
  79.     "Return the value of this run"
  80.  
  81.     ^value!
  82.  
  83. value: anObject
  84.     "Set the value of this run"
  85.  
  86.     value _ anObject! !
  87.  
  88. !Run methodsFor: 'printing'!
  89.  
  90. printOn: aStream 
  91.     "append to aStream a sequence of characters that identifies the 
  92.     receiver. "
  93.  
  94.     aStream nextPutAll: 'a Run(length: ' , self length printString , ' value: ' , self value printString , ')'!
  95.  
  96. storeOn: aStream 
  97.     "Append to aStream an expression which, if evaluated, will generate  
  98.     an object similar to the receiver."
  99.  
  100.     aStream nextPutAll: 'Run new length: ' , self length printString , ' value: ' , self value printString! !
  101. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  102.  
  103. Run class
  104.     instanceVariableNames: ''!
  105.  
  106.  
  107. !Run class methodsFor: 'instance creation'!
  108.  
  109. length: anInteger value: anObject
  110.     "Create a run of length anInteger with value anObject."
  111.  
  112.     ^super new length: anInteger value: anObject!
  113.  
  114. new
  115.     "You probably shouldn't use this"
  116.  
  117.     self length: 0 value: nil! !'
  118.  
  119.  
  120. From Smalltalk-80, Version 2.3 of 13 June 1988 on 18 May 1989 at 10:59:42 am'!
  121.  
  122. OrderedCollection variableSubclass: #CompressedOrderedCollection
  123.     instanceVariableNames: 'collection '
  124.     classVariableNames: ''
  125.     poolDictionaries: ''
  126.     category: 'Collections-Sequenceable'!
  127. CompressedOrderedCollection comment:
  128. 'This implements an ordered collection which uses runs to minimise the amount of data that it holds. Basically it should be used if you know that an ordered collections is giong to contain a lot of runs of eactly the same data. Implemented to allow simultation playback, since the ordered collctions which that generates are so big that the complier falls over, though most of it is extremely repetetive. This should be totally abstracted. The user should not be a ble to see the difference between an ordered collection and a ComrpessedOrderedCollection.  This has a lot in common with RunArray, and the two should probably share implementation. but I could not do some of the things I wanted with the RunArray code, so this is all done on its own.
  129.     Some of this could be made faster by adding a cache of the start and finish indices of each run, but since I envisage that most additions etc. will be to and from the end those are not included. In addition I have implemented the bare essentials of this for what I need it for - i.e. add to the end and take off the beginning.'!
  130.  
  131.  
  132. !CompressedOrderedCollection methodsFor: 'accessing'!
  133.  
  134. after: oldObject 
  135.     "Answer the element after oldObject.  If the receiver does not contain 
  136.      oldObject or if the receiver contains no elements after oldObject,  
  137.     provide an error notification. This is a dumb thing to do to a 
  138.     compressed collection, so no attempt has been made to make it 
  139.     efficient. It answers with the element immediately after oldObject, 
  140.     which probably means it is in the same run and will have the same 
  141.     value. "
  142.  
  143.     | index |
  144.     index _ self find: oldObject.
  145.     index = self size
  146.         ifTrue: [^self errorLastObject]
  147.         ifFalse: [^self at: index + 1]!
  148.  
  149. at: anInteger 
  150.     "Answer the element at index anInteger. 
  151.     at: is used by a knowledgeable client to access an existing element 
  152.     This is a pretty dumb thing to do a compressed collection and it is 
  153.     not at all efficient (think of that as a discouragement."
  154.  
  155.     | position |
  156.     position _ 1.
  157.     (anInteger < 1 or: [anInteger > self size])
  158.         ifTrue: [self errorNoSuchElement]
  159.         ifFalse: [self do: [:element | (position = anInteger)
  160.                     ifTrue: [^element]
  161.                     ifFalse: [position _ position + 1]]]!
  162.  
  163. at: anInteger put: anObject 
  164.     "Put anObject at element index anInteger.      
  165.     at:put: can not be used to append, front or back, to an ordered      
  166.     collection;  it is used by a knowledgeable client to replace an     
  167.     element. It doesn't make a lot of sense for a compressed collection,    
  168.     and as you can see, the implementation is awful - still if you will    
  169.     insist on using this what can you expect. Basically this just copies 
  170.     itself up to the start point then adds the required element then 
  171.     copies the rest of itself"
  172.  
  173.     | newCollection |
  174.     (anInteger < 1 or: [anInteger > self size])
  175.         ifTrue: ["first check the range"
  176.             self errorNoSuchElement]
  177.         ifFalse: [(anInteger = 1 or: [anInteger = self size])
  178.                 ifTrue: [self error: 'Cannot use this for first or last elements']
  179.                 ifFalse: 
  180.                     [newCollection _ self copyFrom: 1 to: anInteger - 1.
  181.                     newCollection addLast: anObject.
  182.                     newCollection addAll: (self copyFrom: anInteger + 1 to: self size).
  183.                     self become: newCollection]]!
  184.  
  185. before: oldObject 
  186.     "Answer the element before oldObject.  If the receiver does not 
  187.     contain oldObject or if the receiver contains no elements before 
  188.     oldObject, provide an error notification. This is a dumb thing to do to 
  189.     a compressed collection, so no attempt has been made to make it 
  190.     efficient. It answers with the element immediately before oldObject, 
  191.     which probably means it is in the same run and will have the same 
  192.     value. "
  193.  
  194.     | index |
  195.     index _ self find: oldObject.
  196.     index = 1
  197.         ifTrue: [^self errorFirstObject]
  198.         ifFalse: [^self at: index - 1]!
  199.  
  200. first
  201.     "Return the value of my first element."
  202.  
  203.     self emptyCheck.
  204.     ^collection first value!
  205.  
  206. last
  207.     "Return the value of my last element."
  208.  
  209.     self emptyCheck.
  210.     ^collection last value!
  211.  
  212. size
  213.     "Answer how many elements the receiver contains."
  214.  
  215.     | size |
  216.     size _ 0.
  217.     collection do: [:run | size _ size + run length].
  218.     ^size! !
  219.  
  220. !CompressedOrderedCollection methodsFor: 'adding'!
  221.  
  222. add: anObject beforeIndex: spot 
  223.     "Add the argument, newObject, as an element of the receiver.  Put it
  224.     in the position just preceding the indexed position spot.  Answer newObject."
  225.  
  226.     self insert: anObject before: spot!
  227.  
  228. addFirst: newObject 
  229.     "Add newObject to the start of this collection."
  230.     "First see if there is anything in this collection - if not just insert a 
  231.     new run."
  232.  
  233.     collection isEmpty
  234.         ifTrue: [collection addLast: (Run length: 1 value: newObject)]
  235.         ifFalse: ["If this is the same value as the first run add it to the run, 
  236.             otherwise add a new run"
  237.             collection first value = newObject
  238.                 ifTrue: [collection first incrementLength]
  239.                 ifFalse: [collection addFirst: (Run length: 1 value: newObject)]]!
  240.  
  241. addLast: newObject 
  242.     "Add newObject to the end of this collection."
  243.     "First see if there is anything in this collection - if not just insert a 
  244.     new run."
  245.  
  246.     collection isEmpty
  247.         ifTrue: [collection addLast: (Run length: 1 value: newObject)]
  248.         ifFalse: ["If this is the same value as the last run add it to the run, 
  249.             otherwise add a new run"
  250.             collection last value = newObject
  251.                 ifTrue: [collection last incrementLength]
  252.                 ifFalse: [collection addLast: (Run length: 1 value: newObject)]]!
  253.  
  254. grow
  255.  
  256. self nogo! !
  257.  
  258. !CompressedOrderedCollection methodsFor: 'removing'!
  259.  
  260. remove: oldObject ifAbsent: anExceptionBlock 
  261.     "Remove oldObject as one of the receiver's elements.  If several of the 
  262.     elements are equal to oldObject, only one is removed. If no element is 
  263.     equal to 
  264.     oldObject, answer the result of evaluating anExceptionBlock.  
  265.     Otherwise, answer the argument, oldObject."
  266.  
  267.     | index found |
  268.     found _ true.
  269.     index _ self find: oldObject ifAbsent: [found _ false].
  270.     found
  271.         ifTrue: 
  272.             [self removeIndex: index.
  273.             ^oldObject]
  274.         ifFalse: [^anExceptionBlock value]!
  275.  
  276. removeAllSuchThat: aBlock 
  277.     "Evaluate aBlock for each element of the receiver.  Remove each 
  278.     element for 
  279.     which aBlock evaluates to true.   
  280.     This is easy - just check for the value of each run and if ablock is 
  281.     true remove the run"
  282.  
  283.     collection removeAllSuchThat: [:aRun | aBlock value: aRun value]!
  284.  
  285. removeAtIndex: anIndex 
  286.     "Remove the element of the collection at position anIndex.  
  287.     Re-implement rather than inherit so that we don't have to faff 
  288.     about with firstIndex whihc is not used anywhere else. Answer the 
  289.     object removed."
  290.  
  291.     | obj |
  292.     obj _ self at: anIndex.
  293.     self removeIndex: anIndex.
  294.     ^obj!
  295.  
  296. removeFirst
  297.     "Remove the first element of the receiver.  If the receiver is empty,   
  298.     provide an error notification."
  299.  
  300.     | returnValue run |
  301.     self emptyCheck.
  302.     run _ collection first.
  303.     returnValue _ run decrementLength.
  304.     run length = 0 ifTrue: [collection removeFirst].
  305.     ^returnValue!
  306.  
  307. removeLast
  308.     "Remove the Last element of the receiver.  If the receiver is empty,   
  309.     provide an error notification."
  310.  
  311.     | returnValue run |
  312.     self emptyCheck.
  313.     run _ collection last.
  314.     returnValue _ run decrementLength.
  315.     run length = 0 ifTrue: [collection removeLast].
  316.     ^returnValue! !
  317.  
  318. !CompressedOrderedCollection methodsFor: 'enumerating'!
  319.  
  320. do: aBlock 
  321.     "Evaluate aBlock with each of the receiver's elements as the 
  322.     argument. "
  323.  
  324.     | runValue |
  325.     collection do: 
  326.         [:aRun | 
  327.         runValue _ aRun value.
  328.         1 to: aRun length do: [:dummy | aBlock value: runValue]]!
  329.  
  330. reverseDo: aBlock
  331.     "Evaluate aBlock with each of the receiver's elements as the argument, starting
  332.     with the last element and taking each in sequence up to the first."
  333.  
  334.     | runValue |
  335.     collection reverseDo: 
  336.         [:aRun | 
  337.         runValue _ aRun value.
  338.         aRun length timesRepeat: [aBlock value: runValue]]! !
  339.  
  340. !CompressedOrderedCollection methodsFor: 'user interface'!
  341.  
  342. inspect
  343.     "Re implement so that they don't get an ordered collection inspector 
  344.     which would get very confused."
  345.  
  346.     self basicInspect! !
  347.  
  348. !CompressedOrderedCollection methodsFor: 'private'!
  349.  
  350. addRun: aRun 
  351.     "Appends aRun to this collection. This is a fast mechanism for 
  352.     constructing compressed collections. Used by storeOn."
  353.  
  354.     collection addLast: aRun!
  355.  
  356. addRunWithLength: anInteger value: anObject
  357.     "Creates the specified run and adds it to this collection. This is a fast mechanism for constructing compressed collections. Used by storeOn."
  358.  
  359.     self addRun: (Run new length: anInteger value: anObject)!
  360.  
  361. find: oldObject 
  362.     "If I contain oldObject return its index, otherwise create an error   
  363.     notifier. It will answer with the position of the very first element of  
  364.     that value."
  365.  
  366.     | position |
  367.     position _ 1.
  368.     self do: [:element | element = oldObject
  369.             ifTrue: [^position]
  370.             ifFalse: [position _ position + 1]].
  371.     self errorNoSuchElement!
  372.  
  373. find: oldObject ifAbsent: exceptionBlock 
  374.     "If I contain oldObject return its index, otherwise execute the 
  375.     exception block. It will answer with the position of the very first 
  376.     element of that value."
  377.  
  378.     | position |
  379.     position _ 1.
  380.     self do: [:element | element = oldObject
  381.             ifTrue: [^position]
  382.             ifFalse: [position _ position + 1]].
  383.     ^exceptionBlock value!
  384.  
  385. insert: anObject before: anIndex 
  386.     "Insert anObject before the object currently at position anIndex"
  387.  
  388.     | newCollection |
  389.     newCollection _ self copyFrom: 1 to: anIndex - 1.
  390.     newCollection addLast: anObject.
  391.     newCollection addAll: (self copyFrom: anIndex to: self size).
  392.     self become: newCollection!
  393.  
  394. isEmpty
  395.     "Am I empty or not. Returns a boolean"
  396.  
  397.     ^collection isEmpty!
  398.  
  399. nogo
  400.     self error: 'Does not make sense for a compressed collection : Not implemented.'!
  401.  
  402. removeIndex: removedIndex 
  403.     "Remove the element of the collection at position anIndex."
  404.  
  405.     | newCollection |
  406.     newCollection _ self copyFrom: 1 to: removedIndex - 1.
  407.     newCollection addAll: (self copyFrom: removedIndex + 1 to: self size).
  408.     self become: newCollection! !
  409.  
  410. !CompressedOrderedCollection methodsFor: 'initialising'!
  411.  
  412. initialize
  413.     "To initialise a new instance. Install the ordered collection that will 
  414.     hold the runs."
  415.  
  416.     collection _ OrderedCollection new.! !
  417.  
  418. !CompressedOrderedCollection methodsFor: 'converting'!
  419.  
  420. asOrderedCollection
  421.     "Uncompress this collection."
  422.  
  423.     | newCollection |
  424.     newCollection _ OrderedCollection new.
  425.     newCollection addAll: self.
  426.     ^newCollection! !
  427.  
  428. !CompressedOrderedCollection methodsFor: 'printing'!
  429.  
  430. storeOn: aStream 
  431.     "Append to aStream an expression which, if evaluated, will generate   
  432.     an object similar to the receiver."
  433.  
  434.     aStream nextPutAll: '(CompressedOrderedCollection new'.
  435.     collection do: [:run | aStream nextPutAll: ' addRunWithLength: ' , run length printString , ' value: (' , run value storeString , ');'].
  436.     aStream nextPutAll: ' yourself)'! !
  437. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  438.  
  439. CompressedOrderedCollection class
  440.     instanceVariableNames: ''!
  441.  
  442.  
  443. !CompressedOrderedCollection class methodsFor: 'instance creation'!
  444.  
  445. new
  446.     "Answer a new empty instance of OrderedCollection.
  447.  
  448.     Have to use basicNew because OrderedCollection re-defines new"
  449.  
  450.     ^(self basicNew) initialize!
  451.  
  452. new: aNumber
  453.     "Answer a new empty instance of OrderedCollection. This is here for compatibility, it totally ignores the parameter, since it is impossible to predict how many runs will be required.
  454.  
  455.     Have to use basicNew because OrderedCollection re-defines new"
  456.  
  457.     ^self new! !
  458.  
  459. 'From Smalltalk-80, Version 2.3 of 13 June 1988 on 18 May 1989 at 11:00:20 am'!
  460.  
  461.  
  462.  
  463. !OrderedCollection methodsFor: 'converting'!
  464.  
  465. asCompressedOrderedCollection
  466.     "Convert this ordered collection into a compressed version of itself."
  467.  
  468. |newCollection|
  469. newCollection _ CompressedOrderedCollection new.
  470. newCollection addAll: self.
  471. ^newCollection! !